home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-08-23 | 21.5 KB | 947 lines | [TEXT/PJMM] |
- unit TCPOOConnections;
-
- { TCPOOConnections © Peter Lewis, April 1993 }
-
- interface
-
- uses
- TCPTypes, TCPStuff, MyTypes;
-
- const
- tooManyConnections = -23099;
- timeoutError = -23098;
- failedToOpenError = -23097;
-
- { Sequence: }
- { new(obj) }
- { oe:=obj.Create }
- { if oe=noErr then begin }
- { do stuff}
- { end; }
- { obj.Destroy }
-
- type
- ConnectionBaseObject = object
- timetodie: boolean; { Set this to have Destroy called at the end of HandleConnection }
- connection_index: integer; { private! }
- closedone, terminatedone: boolean;
- heartbeat_period: longInt; { set to <=0 to disable heartbeats }
- heartbeat_time: longInt; { set to time of next heartbeat, it is automatically incrememnted by the period }
- { To enable heartbeats, set heartbeat_time to TickCount, and heartbeat_period to the period in ticks }
- timeout_time: longInt; { set to time to timeout TickCount }
- drp: ptr; { private! }
- function Create: OSErr;
- procedure Destroy;
- procedure HeartBeat;
- procedure Failed (oe: OSErr);
- procedure Timeout;
- procedure Terminate;
- procedure Close;
- function HandleConnection: boolean;
- end;
- NameSearchObject = object(ConnectionBaseObject)
- ip: longInt;
- function HandleConnection: boolean;
- override;
- procedure FindName (hostIP: longInt);
- procedure FoundName (name: str255; error: OSErr);
- end;
- AddressSearchObject = object(ConnectionBaseObject)
- object_host: str255;
- function HandleConnection: boolean;
- override;
- procedure FindAddress (hostName: str255);
- procedure FoundAddress (ip: longInt);
- end;
- UDPObject = object(ConnectionBaseObject)
- udpcp: UDPConnectionPtr;
- localport: integer;
- function CreatePort (buffer_size: longInt; port: integer): OSErr;
- procedure Close;
- override;
- procedure Terminate;
- override;
- procedure Destroy;
- override;
- function HandleConnection: boolean;
- override;
- procedure PacketAvailable (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer);
- procedure PacketsAvailable (count: integer);
- function SendPacket (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer; checksum: boolean): OSErr;
- end;
- statusType = (CS_LookingUpAddr, CS_Opening, CS_Established, CS_Closing);
- ConnectionObject = object(ConnectionBaseObject)
- lookingupname: boolean;
- active: boolean;
- thebuffersize: longInt;
- ourip: longInt;
- ourport: integer;
- theirip: longInt;
- theirport: integer;
- tcpc: TCPConnectionPtr;
- status: statusType;
- object_host: str255;
- procedure Destroy;
- override;
- function HandleConnection: boolean;
- override;
- procedure NewConnection (actve: boolean; buffersize: longInt; localport: integer; remotehost: str255; remoteport: integer);
- procedure NewPassiveConnection (buffersize: longInt; localport: integer);
- procedure NewActiveConnection (buffersize: longInt; remotehost: str255; remoteport: integer);
- procedure StartConnection;
- procedure Close;
- override;
- procedure Terminate;
- override;
- procedure BeginConnection; { override these }
- procedure Established;
- procedure Closing;
- procedure CharsAvailable (count: longInt);
- end;
- LineConnectionObject = object(ConnectionObject)
- crlf: CRLFTypes;
- buffer_len: longInt; { Current number of characters in buffer }
- buffer: handle; { Size initially set to 512 bytes, change it as you wish }
- last_check: longInt; { buffer_len when we last checked for a line, don't recheck unless it changes }
- pushFlag: boolean; { Hack for the occasionally non-pushed lines, set to true every send }
- line_send_error: OSErr;
- function Create: OSErr;
- override;
- procedure Destroy;
- override;
- procedure SendLine (s: str255);
- procedure LineAvailable (line: str255);
- function CheckLineAvailable: boolean; { You can override this and use buffer & buffer_len yourself }
- function HandleConnection: boolean;
- override;
- procedure CharsAvailable (count: longInt);
- override;
- end;
-
- var
- tcp_our_ip: longInt;
- tcp_our_str: str31;
- tcp_our_name: str255;
-
- function InitConnections (findourname: boolean): OSErr;
- procedure FinishConnections;
- function HandleConnections (maxtime: integer): boolean;
- procedure ConnectionsAddrToString (ip: longInt; var addrStr: str255);
- function ConnectionsAddrToStr (ip: longInt): str255;
- function ConnectionsStrToAddr (s: str255; var addr: longInt): boolean;
- { You probably wont need these: }
- procedure TerminateConnections;
- procedure CloseConnections;
- function CanQuit: boolean;
-
- implementation
-
- uses
- DNR;
-
- const
- TCPCMagic = 'TCPC';
- TCPCBadMagic = 'badc';
-
- const { Tuning parameters }
- max_connections = 64;
- TO_FindAddress = 40 * 60;
- TO_FindName = 40 * 60;
- TO_ActiveOpen = 20 * 60;
- TO_Closing = longInt(2) * 60 * 60;
- TO_PassiveOpen = longInt(10) * 365 * 24 * 3600 * 60; { Ten years should be safe enough right? :-) }
-
- type
- myHostInfo = record
- hi: hostInfo;
- done: signedByte;
- end;
- myHIP = ^myHostInfo;
-
- type
- connectionRecord = record
- obj: ConnectionBaseObject;
- end;
-
- var
- connections: array[1..max_connections] of connectionRecord;
- quiting: boolean;
-
- procedure TrashHandle (h: handle);
- var
- p: ptr;
- i: longInt;
- begin
- if (h <> nil) & (h^ <> nil) then begin
- p := h^;
- for i := 1 to GetHandleSize(h) do begin
- p^ := -27;
- longInt(p) := longInt(p) + 1;
- end;
- end;
- end;
-
- function MyTCPState (con: TCPConnectionPtr): TCPStateType;
- begin
- if con = nil then
- MyTCPState := T_Closed
- else
- MyTCPState := TCPState(con);
- end;
-
- type
- LookupMyName = object(NameSearchObject)
- procedure FoundName (name: str255; error: OSErr);
- override;
- end;
-
- procedure LookupMyName.FoundName (name: str255; error: OSErr);
- begin
- tcp_our_name := name;
- end;
-
- {$S Init}
- function InitConnections (findourname: boolean): OSErr;
- var
- oe, ooe: OSErr;
- i: integer;
- lobj: LookupMyName;
- begin
- quiting := false;
- icmp_sent_out := 0;
- icmp_got_back := 0;
- for i := 1 to max_connections do
- connections[i].obj := nil;
- oe := TCPInit;
- if oe = noErr then begin
- oe := OpenResolver;
- if oe = noErr then begin
- oe := IPGetMyIPAddr(tcp_our_ip);
- tcp_our_str := ConnectionsAddrToStr(tcp_our_ip);
- tcp_our_name := tcp_our_str;
- if findourname then begin
- new(lobj);
- lobj.FindName(tcp_our_ip);
- end;
- end;
- if oe <> noErr then
- TCPFinish;
- end;
- InitConnections := oe;
- end;
- {$S}
-
- {$S Term}
- procedure TerminateConnections;
- var
- i: integer;
- begin
- for i := 1 to max_connections do
- if connections[i].obj <> nil then begin
- if not connections[i].obj.terminatedone then
- connections[i].obj.Terminate;
- end;
- end;
- {$S}
-
- {$S Term}
- procedure CloseConnections;
- var
- i: integer;
- begin
- for i := 1 to max_connections do
- if connections[i].obj <> nil then begin
- connections[i].obj.Close;
- end;
- end;
- {$S}
-
- {$S Term}
- function CanQuit: boolean;
- var
- i: integer;
- begin
- CanQuit := icmp_sent_out = icmp_got_back;
- for i := 1 to max_connections do
- if connections[i].obj <> nil then begin
- CanQuit := false;
- leave;
- end;
- end;
-
- {$S Term}
- procedure FinishConnections;
- var
- dummy: boolean;
- er: eventRecord;
- begin
- quiting := true;
- while not CanQuit do begin
- TerminateConnections;
- if HandleConnections(3) then begin
- dummy := WaitNextEvent(everyEvent, er, 0, nil);
- end
- else
- dummy := WaitNextEvent(everyEvent, er, 5, nil);
- end;
- CloseResolver;
- TCPFinish;
- end;
- {$S}
-
- function ConnectionBaseObject.Create: OSErr;
- var
- i: integer;
- oe: OSErr;
- begin
- MoveHHi(handle(self));
- HLock(handle(self));
- if quiting then begin
- oe := -12;
- end
- else begin
- i := 1;
- while (i <= max_connections) & (connections[i].obj <> nil) do
- i := i + 1;
- if i <= max_connections then begin
- timetodie := false;
- connection_index := i;
- connections[i].obj := self;
- heartbeat_period := 0;
- heartbeat_time := 0;
- timeout_time := maxLongInt;
- closedone := false;
- terminatedone := false;
- drp := NewPtr(SizeOf(DNRRecord));
- oe := MemError;
- end
- else begin
- connection_index := -1;
- oe := tooManyConnections;
- end;
- end;
- Create := oe;
- end;
-
- procedure ConnectionBaseObject.Destroy;
- begin
- if connection_index > 0 then
- connections[connection_index].obj := nil;
- if drp <> nil then
- DisposePtr(drp);
- TrashHandle(handle(self));
- dispose(self);
- end;
-
- procedure ConnectionBaseObject.HeartBeat;
- begin
- end;
-
- procedure ConnectionBaseObject.Failed (oe: OSErr);
- begin
- timetodie := true;
- end;
-
- procedure ConnectionBaseObject.Timeout;
- begin
- Failed(timeoutError);
- end;
-
- procedure ConnectionBaseObject.Terminate;
- begin
- terminatedone := true;
- end;
-
- procedure ConnectionBaseObject.Close;
- begin
- closedone := true;
- end;
-
- function ConnectionBaseObject.HandleConnection: boolean;
- var
- now: longInt;
- begin
- HandleConnection := false;
- now := TickCount;
- if now > timeout_time then begin
- timeout_time := maxLongInt;
- Timeout;
- HandleConnection := true;
- end
- else if (heartbeat_period > 0) & (now >= heartbeat_time) then begin
- HeartBeat;
- heartbeat_time := heartbeat_time + heartbeat_period;
- HandleConnection := true;
- end;
- end;
-
- procedure AddressSearchObject.FindAddress (hostName: str255);
- var
- oe: OSErr;
- begin
- oe := Create;
- if oe = noErr then begin
- object_host := hostName;
- DNRNameToAddr(hostName, DNRRecordPtr(drp), nil);
- timeout_time := TickCount + TO_FindAddress;
- end;
- if oe <> noErr then begin
- Failed(oe);
- Destroy;
- end;
- end;
-
- procedure AddressSearchObject.FoundAddress (ip: longInt);
- begin
- end;
-
- function AddressSearchObject.HandleConnection: boolean;
- begin
- with DNRRecordPtr(drp)^ do begin
- if ioResult = noErr then begin
- { TCPSetCache(hi, object_host);}
- FoundAddress(addr);
- timetodie := true;
- HandleConnection := true;
- end
- else if ioResult <> inProgress then begin
- Failed(ioResult);
- timetodie := true;
- HandleConnection := true;
- end
- else begin
- HandleConnection := inherited HandleConnection;
- end;
- end; {with}
- end;
-
- procedure NameSearchObject.FindName (hostIP: longInt);
- var
- oe: OSErr;
- hostname: str255;
- begin
- ip := hostIP;
- oe := Create;
- if oe = noErr then begin
- DNRAddrToName(hostIP, DNRRecordPtr(drp), nil);
- timeout_time := TickCount + TO_FindName;
- end;
- if oe <> noErr then begin
- Failed(oe);
- Destroy;
- end;
- end;
-
- procedure NameSearchObject.FoundName (name: str255; error: OSErr);
- begin
- end;
-
- function NameSearchObject.HandleConnection: boolean;
- begin
- with DNRRecordPtr(drp)^ do begin
- if ioResult <> inProgress then begin
- FoundName(name, ioResult);
- timetodie := true;
- HandleConnection := true;
- end
- else begin
- HandleConnection := inherited HandleConnection;
- end;
- end; {with}
- end;
-
- procedure ConnectionObject.Established;
- begin
- end;
-
- procedure ConnectionObject.Closing;
- begin
- Close;
- end;
-
- procedure ConnectionObject.CharsAvailable (count: longInt);
- begin
- end;
-
- procedure ConnectionObject.Destroy;
- var
- tmp_tcpc: TCPConnectionPtr;
- oe: OSErr;
- begin
- if tcpc <> nil then begin
- oe := TCPAbort(tcpc);
- tmp_tcpc := tcpc;
- oe := TCPRelease(tmp_tcpc);
- end;
- inherited Destroy;
- end;
-
- procedure ConnectionObject.BeginConnection;
- begin
- end;
-
- procedure ConnectionObject.StartConnection;
- var
- oe: OSErr;
- tmp_tcpc: TCPConnectionPtr;
- begin
- if active then begin
- oe := TCPActiveOpen(tmp_tcpc, thebuffersize, ourport, theirip, theirport, nil);
- timeout_time := TickCount + TO_ActiveOpen;
- end
- else begin
- oe := TCPPassiveOpen(tmp_tcpc, thebuffersize, ourport, theirip, theirport, nil);
- timeout_time := TickCount + TO_PassiveOpen;
- end;
- tcpc := tmp_tcpc;
- status := CS_Opening;
- if oe = noErr then begin
- ourport := TCPLocalPort(tcpc);
- BeginConnection;
- end
- else begin
- Failed(oe);
- timetodie := true;
- end;
- end;
-
- procedure ConnectionObject.NewConnection (actve: boolean; buffersize: longInt; localport: integer; remotehost: str255; remoteport: integer);
- var
- oe: OSErr;
- ip: longInt;
- begin
- status := CS_LookingUpAddr;
- tcpc := nil;
- oe := Create;
- if oe = noErr then begin
- active := actve;
- thebuffersize := buffersize;
- ourport := localport;
- ourip := tcp_our_ip;
- theirip := 0;
- theirport := remoteport;
- ip := 0;
- if (remotehost = '') | ConnectionsStrToAddr(remotehost, ip) then begin
- if (ip = 0) & active then begin
- oe := -11;
- end
- else begin
- theirip := ip;
- DisposePtr(drp);
- drp := nil;
- StartConnection;
- end;
- end
- else begin
- object_host := remotehost;
- DNRNameToAddr(remotehost, DNRRecordPtr(drp), nil);
- timeout_time := TickCount + TO_FindAddress;
- end;
- end;
- if oe <> noErr then begin
- tcpc := nil;
- Failed(oe);
- timetodie := true;
- end;
- if timetodie then
- Destroy;
- end;
-
- procedure ConnectionObject.NewPassiveConnection (buffersize: longInt; localport: integer);
- begin
- NewConnection(false, buffersize, localport, '', 0);
- end;
-
- procedure ConnectionObject.NewActiveConnection (buffersize: longInt; remotehost: str255; remoteport: integer);
- begin
- NewConnection(true, buffersize, 0, remotehost, remoteport);
- end;
-
- procedure ConnectionObject.Close;
- var
- oe: OSErr;
- begin
- if not closedone and (tcpc <> nil) then begin
- oe := TCPClose(tcpc, nil);
- closedone := true;
- end;
- end;
-
- procedure ConnectionObject.Terminate;
- var
- oe: OSErr;
- begin
- if not terminatedone and (tcpc <> nil) then begin
- oe := TCPAbort(tcpc);
- terminatedone := true;
- end;
- end;
-
- function ConnectionObject.HandleConnection: boolean;
- var
- didit: boolean;
- count: longInt;
- state: TCPStateType;
- begin
- didit := false;
- state := MyTCPState(tcpc);
- case status of
- CS_LookingUpAddr: begin
- if DNRRecordPtr(drp)^.ioResult = noErr then begin
- { TCPSetCache(myHIP(hip)^.hi, object_host);}
- theirip := DNRRecordPtr(drp)^.addr;
- DisposePtr(drp);
- StartConnection;
- didit := true;
- end
- else if DNRRecordPtr(drp)^.ioResult <> inProgress then begin
- Failed(DNRRecordPtr(drp)^.ioResult);
- timetodie := true;
- didit := true;
- end;
- end;
- CS_Opening: begin
- case state of
- T_WaitingForOpen, T_Opening, T_Listening:
- ;
- T_Established: begin
- Established;
- status := CS_Established;
- timeout_time := maxLongInt;
- didit := true;
- end;
- T_PleaseClose, T_Closing, T_Closed: begin
- didit := true;
- Failed(failedToOpenError);
- timetodie := true;
- end;
- otherwise
- ;
- end; {case }
- end;
- CS_Established: begin
- case state of
- T_Established: begin
- count := TCPCharsAvailable(tcpc);
- if count > 0 then begin
- CharsAvailable(count);
- didit := true;
- end;
- end;
- T_PleaseClose, T_Closing: begin
- count := TCPCharsAvailable(tcpc);
- if count > 0 then begin
- CharsAvailable(count);
- didit := true;
- end
- else begin
- Closing;
- status := CS_Closing;
- timeout_time := TickCount + TO_Closing;
- didit := true;
- end;
- end;
- T_Closed: begin
- Closing;
- status := CS_Closing;
- timeout_time := TickCount + TO_Closing;
- didit := true;
- end;
- otherwise
- ;
- end;
- end;
- CS_Closing: begin
- case state of
- T_PleaseClose, T_Closing, T_Established: begin
- count := TCPCharsAvailable(tcpc);
- if count > 0 then begin
- CharsAvailable(count);
- didit := true;
- end;
- end;
- T_Closed: begin
- timetodie := true;
- didit := true;
- end;
- otherwise
- ;
- end;
- end;
- otherwise
- ;
- end;
- didit := didit | inherited HandleConnection;
- HandleConnection := didit;
- end;
-
- function LineConnectionObject.Create: OSErr;
- begin
- crlf := CL_CRLF;
- buffer := NewHandle(512);
- buffer_len := 0;
- last_check := -1;
- pushFlag := true;
- line_send_error := noErr;
- Create := inherited Create;
- end;
-
- procedure LineConnectionObject.Destroy;
- begin
- DisposeHandle(buffer);
- inherited Destroy;
- end;
-
- procedure LineConnectionObject.SendLine (s: str255);
- var
- oe: OSErr;
- begin
- if crlf <> CL_LF then
- s := concat(s, cr);
- if crlf <> CL_CR then
- s := concat(s, lf);
- oe := TCPSendAsync(tcpc, @s[1], length(s), pushFlag, nil);
- if line_send_error = noErr then
- line_send_error := oe;
- pushFlag := true;
- end;
-
- procedure LineConnectionObject.LineAvailable (line: str255);
- begin
- end;
-
- procedure LineConnectionObject.CharsAvailable (count: longInt);
- var
- space: longint;
- oe: OSErr;
- dummy: boolean;
- begin
- space := GetHandleSize(buffer) - buffer_len;
- if count > space then
- count := space;
- if count > 32767 then
- count := 32767;
- if count > 0 then begin
- HLock(buffer);
- oe := TCPRawReceiveChars(tcpc, ptr(ord(buffer^) + buffer_len), count);
- HUnlock(buffer);
- buffer_len := buffer_len + count;
- dummy := CheckLineAvailable;
- end;
- end;
-
- function LineConnectionObject.CheckLineAvailable: boolean;
- var
- len, l: longInt;
- p: ptr;
- s: str255;
- begin
- CheckLineAvailable := false;
- if (buffer_len > 0) & (buffer_len <> last_check) then begin
- p := buffer^;
- len := 0;
- while (len < buffer_len) & (len < 255) & (p^ <> ord(lf)) & (p^ <> ord(cr)) do begin
- p := ptr(ord(p) + 1);
- len := len + 1;
- end;
- if (len = 255) | ((len < buffer_len) & ((p^ = ord(lf)) or (p^ = ord(cr)))) then begin
- {$PUSH}
- {$R-}
- s[0] := chr(len);
- BlockMove(buffer^, @s[1], len);
- {$POP}
- if (len < buffer_len) & (p^ = ord(cr)) then begin
- p := ptr(ord(p) + 1);
- len := len + 1;
- end;
- if (len < buffer_len) & (p^ = ord(lf)) then begin
- p := ptr(ord(p) + 1);
- len := len + 1;
- end;
- BlockMove(p, buffer^, buffer_len - len);
- buffer_len := buffer_len - len;
- LineAvailable(s);
- CheckLineAvailable := true;
- last_check := -1;
- end
- else begin
- last_check := buffer_len;
- end;
- end;
- end;
-
- function LineConnectionObject.HandleConnection: boolean;
- begin
- HandleConnection := inherited HandleConnection | CheckLineAvailable;
- end;
-
- function UDPObject.CreatePort (buffer_size: longInt; port: integer): OSErr;
- var
- oe: OSErr;
- tmp_udpcp: UDPConnectionPtr;
- begin
- oe := Create;
- if oe = noErr then begin
- oe := UDPCreate(tmp_udpcp, buffer_size, port);
- udpcp := tmp_udpcp;
- localport := port;
- timeout_time := maxLongInt;
- end;
- if oe <> noErr then begin
- udpcp := nil;
- Destroy;
- end;
- CreatePort := oe;
- end;
-
- procedure UDPObject.Terminate;
- begin
- timetodie := true;
- end;
-
- procedure UDPObject.Close;
- var
- tmp_udpcp: UDPConnectionPtr;
- oe: OSErr;
- begin
- if udpcp <> nil then begin
- tmp_udpcp := udpcp;
- oe := UDPRelease(tmp_udpcp);
- udpcp := nil;
- end;
- timetodie := true;
- end;
-
- procedure UDPObject.Destroy;
- begin
- if udpcp <> nil then begin
- Close;
- end;
- inherited Destroy;
- end;
-
- procedure UDPObject.PacketAvailable (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer);
- begin
- end;
-
- procedure UDPObject.PacketsAvailable (count: integer);
- var
- oe: OSErr;
- remoteIP: longInt;
- remoteport: integer;
- datap: ptr;
- datalen: integer;
- u: UDPConnectionPtr;
- begin
- oe := UDPRead(udpcp, 1, remoteIP, remoteport, datap, datalen);
- if oe = noErr then begin
- u := udpcp;
- PacketAvailable(remoteIP, remoteport, datap, datalen);
- { self may be nil now }
- oe := UDPReturnBuffer(u, datap);
- end;
- end;
-
- function UDPObject.SendPacket (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer; checksum: boolean): OSErr;
- begin
- SendPacket := UDPWrite(udpcp, remoteIP, remoteport, datap, datalen, checksum);
- end;
-
- function UDPObject.HandleConnection: boolean;
- var
- didit: boolean;
- count: longInt;
- begin
- didit := false;
- if udpcp <> nil then begin
- count := UDPDatagramsAvailable(udpcp);
- if count > 0 then begin
- PacketsAvailable(count);
- didit := true;
- end;
- end;
- HandleConnection := didit | inherited HandleConnection;
- end;
-
- function HandleConnections (maxtime: integer): boolean;
- var
- did, didany: boolean;
- start: longInt;
- i: integer;
- begin
- start := TickCount;
- didany := false;
- repeat
- did := false;
- for i := 1 to max_connections do begin
- if connections[i].obj <> nil then begin
- if connections[i].obj.HandleConnection then begin
- did := true;
- didany := true;
- end;
- if (connections[i].obj <> nil) & (connections[i].obj.timetodie) then begin
- connections[i].obj.Destroy;
- end;
- end;{if}
- end; {for}
- until not did or (TickCount >= start + maxtime);
- HandleConnections := didany;
- end;
-
- function ConnectionsStrToAddr (s: str255; var addr: longInt): boolean;
- var
- good: boolean;
- procedure Get1;
- var
- b: integer;
- begin
- if (length(s) = 0) | not (s[1] in ['0'..'9']) then
- good := false
- else begin
- b := ord(s[1]) - 48;
- s := copy(s, 2, 255);
- if (s <> '') & (s[1] in ['0'..'9']) then begin
- b := b * 10 + ord(s[1]) - 48;
- s := copy(s, 2, 255);
- end;
- if (s <> '') & (s[1] in ['0'..'9']) then begin
- b := b * 10 + ord(s[1]) - 48;
- s := copy(s, 2, 255);
- end;
- if (s <> '') & (s[1] = '.') then begin
- s := copy(s, 2, 255);
- end;
- if b > 255 then begin
- good := false;
- b := 0; { avoid overflow error? }
- end;
- addr := BOR(BSL(addr, 8), b);
- end;
- end;
- begin
- good := true;
- addr := 0;
- Get1;
- Get1;
- Get1;
- Get1;
- good := good & (s = '');
- if not good then
- addr := 0;
- ConnectionsStrToAddr := good;
- end;
-
- procedure ConnectionsAddrToString (ip: longInt; var addrStr: str255);
- begin
- AddrToStr(ip, addrStr);
- end;
-
- function ConnectionsAddrToStr (ip: longInt): str255;
- var
- s: str255;
- begin
- AddrToStr(ip, s);
- ConnectionsAddrToStr := s;
- end;
-
- end.